home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / scktcomp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-29  |  54.2 KB  |  1,893 lines
  1. unit ScktComp;
  2.  
  3. interface
  4.  
  5. { TODO:
  6.  
  7.     o Clean-up server component.
  8.     o Investigate roving accept socket among all server client threads.
  9.       o Remove the TServerAcceptThread.
  10.     - Investigate merging the TCustomWinSocket and TCustomSocket
  11.     x Implement blocking client socket mode
  12. }
  13.  
  14. uses SysUtils, Windows, Messages, Classes, WinSock, SyncObjs;
  15.  
  16. const
  17.   CM_SOCKETMESSAGE = WM_USER + $0001;
  18.  
  19. type
  20.   ESocketError = class(Exception);
  21.  
  22.   TCMSocketMessage = record
  23.     Msg: Cardinal;
  24.     Socket: TSocket;
  25.     SelectEvent: Word;
  26.     SelectError: Word;
  27.     Result: Longint;
  28.   end;
  29.  
  30.   TCustomWinSocket = class;
  31.   TCustomSocket = class;
  32.   TServerAcceptThread = class;
  33.   TServerClientThread = class;
  34.   TServerWinSocket = class;
  35.   TServerClientWinSocket = class;
  36.  
  37.   TServerType = (stNonBlocking, stThreadBlocking);
  38.   TClientType = (ctNonBlocking, ctBlocking);
  39.   TAsyncStyle = (asRead, asWrite, asOOB, asAccept, asConnect, asClose);
  40.   TAsyncStyles = set of TAsyncStyle;
  41.   TSocketEvent = (seLookup, seConnecting, seConnect, seDisconnect, seListen,
  42.     seAccept, seWrite, seRead);
  43.   TErrorEvent = (eeGeneral, eeSend, eeReceive, eeConnect, eeDisconnect, eeAccept);
  44.  
  45.   TSocketEventEvent = procedure (Sender: TObject; Socket: TCustomWinSocket;
  46.     SocketEvent: TSocketEvent) of object;
  47.   TSocketErrorEvent = procedure (Sender: TObject; Socket: TCustomWinSocket;
  48.     ErrorEvent: TErrorEvent; var ErrorCode: Integer) of object;
  49.   TGetSocketEvent = procedure (Sender: TObject; Socket: TSocket;
  50.     var ClientSocket: TServerClientWinSocket) of object;
  51.   TGetThreadEvent = procedure (Sender: TObject; ClientSocket: TServerClientWinSocket;
  52.     var SocketThread: TServerClientThread) of object;
  53.   TSocketNotifyEvent = procedure (Sender: TObject; Socket: TCustomWinSocket) of object;
  54.  
  55.   TCustomWinSocket = class
  56.   private
  57.     FSocket: TSocket;
  58.     FConnected: Boolean;
  59.     FSendStream: TStream;
  60.     FDropAfterSend: Boolean;
  61.     FHandle: HWnd;
  62.     FAddr: TSockAddrIn;
  63.     FAsyncStyles: TASyncStyles;
  64.     FOnSocketEvent: TSocketEventEvent;
  65.     FOnErrorEvent: TSocketErrorEvent;
  66.     FSocketLock: TCriticalSection;
  67.     FData: Pointer;
  68.     function SendStreamPiece: Boolean;
  69.     procedure DefaultHandler(var Message); override;
  70.     procedure WndProc(var Message: TMessage);
  71.     procedure CMSocketMessage(var Message: TCMSocketMessage); message CM_SOCKETMESSAGE;
  72.     procedure DoSetAsyncStyles;
  73.     function GetHandle: HWnd;
  74.     function GetLocalHost: string;
  75.     function GetLocalAddress: string;
  76.     function GetLocalPort: Integer;
  77.     function GetRemoteHost: string;
  78.     function GetRemoteAddress: string;
  79.     function GetRemotePort: Integer;
  80.     function GetRemoteAddr: TSockAddrIn;
  81.   protected
  82.     function InitSocket(var Name, Address, Service: string; Port: Word;
  83.       Client: Boolean): TSockAddrIn;
  84.     procedure Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent); dynamic;
  85.     procedure Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  86.       var ErrorCode: Integer); dynamic;
  87.     procedure SetAsyncStyles(Value: TASyncStyles);
  88.     procedure Listen(var Name, Address, Service: string; Port: Word;
  89.       QueueSize: Integer);
  90.     procedure Open(var Name, Address, Service: string; Port: Word);
  91.     procedure Accept(Socket: TSocket); virtual;
  92.     procedure Connect(Socket: TSocket); virtual;
  93.     procedure Disconnect(Socket: TSocket); virtual;
  94.     procedure Read(Socket: TSocket); virtual;
  95.     procedure Write(Socket: TSocket); virtual;
  96.   public
  97.     constructor Create(ASocket: TSocket);
  98.     destructor Destroy; override;
  99.     procedure Close;
  100.     procedure Lock;
  101.     procedure Unlock;
  102.     function LookupName(const name: string) : TInAddr;
  103.     function LookupService(const service: string): Integer;
  104.  
  105.     function ReceiveLength: Integer;
  106.     function ReceiveBuf(var Buf; Count: Integer): Integer;
  107.     function ReceiveText: string;
  108.     function SendBuf(var Buf; Count: Integer): Integer;
  109.     function SendStream(AStream: TStream): Boolean;
  110.     function SendStreamThenDrop(AStream: TStream): Boolean;
  111.     procedure SendText(const S: string);
  112.  
  113.     property LocalHost: string read GetLocalHost;
  114.     property LocalAddress: string read GetLocalAddress;
  115.     property LocalPort: Integer read GetLocalPort;
  116.  
  117.     property RemoteHost: string read GetRemoteHost;
  118.     property RemoteAddress: string read GetRemoteAddress;
  119.     property RemotePort: Integer read GetRemotePort;
  120.     property RemoteAddr: TSockAddrIn read GetRemoteAddr;
  121.  
  122.     property Connected: Boolean read FConnected;
  123.     property Addr: TSockAddrIn read FAddr;
  124.     property ASyncStyles: TAsyncStyles read FAsyncStyles write SetAsyncStyles;
  125.     property Handle: HWnd read GetHandle;
  126.     property SocketHandle: TSocket read FSocket;
  127.  
  128.     property OnSocketEvent: TSocketEventEvent read FOnSocketEvent write FOnSocketEvent;
  129.     property OnErrorEvent: TSocketErrorEvent read FOnErrorEvent write FOnErrorEvent;
  130.  
  131.     property Data: Pointer read FData write FData;
  132.   end;
  133.  
  134.   TClientWinSocket = class(TCustomWinSocket)
  135.   private
  136.     FClientType: TClientType;
  137.   protected
  138.     procedure Connect(Socket: TSocket); override;
  139.     procedure SetClientType(Value: TClientType);
  140.   public
  141.     property ClientType: TClientType read FClientType write SetClientType;
  142.   end;
  143.  
  144.   TServerClientWinSocket = class(TCustomWinSocket)
  145.   private
  146.     FServerWinSocket: TServerWinSocket;
  147.   public
  148.     constructor Create(Socket: TSocket; ServerWinSocket: TServerWinSocket);
  149.     destructor Destroy; override;
  150.  
  151.     property ServerWinSocket: TServerWinSocket read FServerWinSocket;
  152.   end;
  153.  
  154.   TThreadNotifyEvent = procedure (Sender: TObject;
  155.     Thread: TServerClientThread) of object;
  156.  
  157.   TServerWinSocket = class(TCustomWinSocket)
  158.   private
  159.     FServerType: TServerType;
  160.     FThreadCacheSize: Integer;
  161.     FConnections: TList;
  162.     FActiveThreads: TList;
  163.     FListLock: TCriticalSection;
  164.     FServerAcceptThread: TServerAcceptThread;
  165.     FOnGetSocket: TGetSocketEvent;
  166.     FOnGetThread: TGetThreadEvent;
  167.     FOnThreadStart: TThreadNotifyEvent;
  168.     FOnThreadEnd: TThreadNotifyEvent;
  169.     FOnClientConnect: TSocketNotifyEvent;
  170.     FOnClientDisconnect: TSocketNotifyEvent;
  171.     FOnClientRead: TSocketNotifyEvent;
  172.     FOnClientWrite: TSocketNotifyEvent;
  173.     FOnClientError: TSocketErrorEvent;
  174.     procedure AddClient(AClient: TServerClientWinSocket);
  175.     procedure RemoveClient(AClient: TServerClientWinSocket);
  176.     procedure AddThread(AThread: TServerClientThread);
  177.     procedure RemoveThread(AThread: TServerClientThread);
  178.     procedure ClientEvent(Sender: TObject; Socket: TCustomWinSocket;
  179.       SocketEvent: TSocketEvent);
  180.     procedure ClientError(Sender: TObject; Socket: TCustomWinSocket;
  181.       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  182.     function GetActiveConnections: Integer;
  183.     function GetActiveThreads: Integer;
  184.     function GetConnections(Index: Integer): TCustomWinSocket;
  185.     function GetIdleThreads: Integer;
  186.   protected
  187.     procedure Accept(Socket: TSocket); override;
  188.     procedure Disconnect(Socket: TSocket); override;
  189.     function DoCreateThread(ClientSocket: TServerClientWinSocket): TServerClientThread; virtual;
  190.     procedure Listen(var Name, Address, Service: string; Port: Word;
  191.       QueueSize: Integer);
  192.     procedure SetServerType(Value: TServerType);
  193.     procedure SetThreadCacheSize(Value: Integer);
  194.     procedure ThreadEnd(AThread: TServerClientThread); dynamic;
  195.     procedure ThreadStart(AThread: TServerClientThread); dynamic;
  196.     function GetClientSocket(Socket: TSocket): TServerClientWinSocket; dynamic;
  197.     function GetServerThread(ClientSocket: TServerClientWinSocket): TServerClientThread; dynamic;
  198.     procedure ClientRead(Socket: TCustomWinSocket); dynamic;
  199.     procedure ClientWrite(Socket: TCustomWinSOcket); dynamic;
  200.     procedure ClientConnect(Socket: TCustomWinSOcket); dynamic;
  201.     procedure ClientDisconnect(Socket: TCustomWinSOcket); dynamic;
  202.     procedure ClientErrorEvent(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  203.       var ErrorCode: Integer); dynamic;
  204.   public
  205.     constructor Create(ASocket: TSocket);
  206.     destructor Destroy; override;
  207.     function GetClientThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
  208.     property ActiveConnections: Integer read GetActiveConnections;
  209.     property ActiveThreads: Integer read GetActiveThreads;
  210.     property Connections[Index: Integer]: TCustomWinSocket read GetConnections;
  211.     property IdleThreads: Integer read GetIdleThreads;
  212.     property ServerType: TServerType read FServerType write SetServerType;
  213.     property ThreadCacheSize: Integer read FThreadCacheSize write SetThreadCacheSize;
  214.     property OnGetSocket: TGetSocketEvent read FOnGetSocket write FOnGetSocket;
  215.     property OnGetThread: TGetThreadEvent read FOnGetThread write FOnGetThread;
  216.     property OnThreadStart: TThreadNotifyEvent read FOnThreadStart write FOnThreadStart;
  217.     property OnThreadEnd: TThreadNotifyEvent read FOnThreadEnd write FOnThreadEnd;
  218.     property OnClientConnect: TSocketNotifyEvent read FOnClientConnect write FOnClientConnect;
  219.     property OnClientDisconnect: TSocketNotifyEvent read FOnClientDisconnect write FOnClientDisconnect;
  220.     property OnClientRead: TSocketNotifyEvent read FOnClientRead write FOnClientRead;
  221.     property OnClientWrite: TSocketNotifyEvent read FOnClientWrite write FOnClientWrite;
  222.     property OnClientError: TSocketErrorEvent read FOnClientError write FOnClientError;
  223.   end;
  224.  
  225.   TServerAcceptThread = class(TThread)
  226.   private
  227.     FServerSocket: TServerWinSocket;
  228.   public
  229.     constructor Create(CreateSuspended: Boolean; ASocket: TServerWinSocket);
  230.     procedure Execute; override;
  231.  
  232.     property ServerSocket: TServerWinSocket read FServerSocket;
  233.   end;
  234.  
  235.   TServerClientThread = class(TThread)
  236.   private
  237.     FClientSocket: TServerClientWinSocket;
  238.     FServerSocket: TServerWinSocket;
  239.     FException: Exception;
  240.     FEvent: TSimpleEvent;
  241.     FKeepInCache: Boolean;
  242.     FData: Pointer;
  243.     procedure HandleEvent(Sender: TObject; Socket: TCustomWinSocket;
  244.       SocketEvent: TSocketEvent);
  245.     procedure HandleError(Sender: TObject; Socket: TCustomWinSocket;
  246.       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  247.     procedure DoHandleException;
  248.     procedure DoRead;
  249.     procedure DoWrite;
  250.   protected
  251.     procedure DoTerminate; override;
  252.     procedure Execute; override;
  253.     procedure ClientExecute; virtual;
  254.     procedure Event(SocketEvent: TSocketEvent); virtual;
  255.     procedure Error(ErrorEvent: TErrorEvent; var ErrorCode: Integer); virtual;
  256.     procedure HandleException; virtual;
  257.     procedure ReActivate(ASocket: TServerClientWinSocket);
  258.     function StartConnect: Boolean;
  259.     function EndConnect: Boolean;
  260.   public
  261.     constructor Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
  262.     destructor Destroy; override;
  263.  
  264.     property ClientSocket: TServerClientWinSocket read FClientSocket;
  265.     property ServerSocket: TServerWinSocket read FServerSocket;
  266.     property KeepInCache: Boolean read FKeepInCache write FKeepInCache;
  267.     property Data: Pointer read FData write FData;
  268.   end;
  269.  
  270.   TCustomSocket = class(TComponent)
  271.   private
  272.     FActive: Boolean;
  273.     FOnLookup: TSocketNotifyEvent;
  274.     FOnConnect: TSocketNotifyEvent;
  275.     FOnConnecting: TSocketNotifyEvent;
  276.     FOnDisconnect: TSocketNotifyEvent;
  277.     FOnListen: TSocketNotifyEvent;
  278.     FOnAccept: TSocketNotifyEvent;
  279.     FOnRead: TSocketNotifyEvent;
  280.     FOnWrite: TSocketNotifyEvent;
  281.     FOnError: TSocketErrorEvent;
  282.     FPort: Integer;
  283.     FAddress: string;
  284.     FHost: string;
  285.     FService: string;
  286.     procedure DoEvent(Sender: TObject; Socket: TCustomWinSocket;
  287.       SocketEvent: TSocketEvent);
  288.     procedure DoError(Sender: TObject; Socket: TCustomWinSocket;
  289.       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  290.   protected
  291.     procedure Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent); virtual;
  292.     procedure Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  293.       var ErrorCode: Integer); virtual;
  294.     procedure DoActivate(Value: Boolean); virtual; abstract;
  295.     procedure Loaded; override;
  296.     procedure SetActive(Value: Boolean);
  297.     procedure SetAddress(Value: string);
  298.     procedure SetHost(Value: string);
  299.     procedure SetPort(Value: Integer);
  300.     procedure SetService(Value: string);
  301.     property Active: Boolean read FActive write SetActive;
  302.     property Address: string read FAddress write SetAddress;
  303.     property Host: string read FHost write SetHost;
  304.     property Port: Integer read FPort write SetPort;
  305.     property Service: string read FService write SetService;
  306.     property OnLookup: TSocketNotifyEvent read FOnLookup write FOnLookup;
  307.     property OnConnecting: TSocketNotifyEvent read FOnConnecting write FOnConnecting;
  308.     property OnConnect: TSocketNotifyEvent read FOnConnect write FOnConnect;
  309.     property OnDisconnect: TSocketNotifyEvent read FOnDisconnect write FOnDisconnect;
  310.     property OnListen: TSocketNotifyEvent read FOnListen write FOnListen;
  311.     property OnAccept: TSocketNotifyEvent read FOnAccept write FOnAccept;
  312.     property OnRead: TSocketNotifyEvent read FOnRead write FOnRead;
  313.     property OnWrite: TSocketNotifyEvent read FOnWrite write FOnWrite;
  314.     property OnError: TSocketErrorEvent read FOnError write FOnError;
  315.   public
  316.     procedure Open;
  317.     procedure Close;
  318.   end;
  319.  
  320.   TWinSocketStream = class(TStream)
  321.   private
  322.     FSocket: TCustomWinSocket;
  323.     FTimeout: Longint;
  324.     FEvent: TSimpleEvent;
  325.   public
  326.     constructor Create(ASocket: TCustomWinSocket; TimeOut: Longint);
  327.     destructor Destroy; override;
  328.     function WaitForData(Timeout: Longint): Boolean;
  329.     function Read(var Buffer; Count: Longint): Longint; override;
  330.     function Write(const Buffer; Count: Longint): Longint; override;
  331.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  332.     property TimeOut: Longint read FTimeout write FTimeout;
  333.   end;
  334.  
  335.   TClientSocket = class(TCustomSocket)
  336.   private
  337.     FClientSocket: TClientWinSocket;
  338.     procedure DoActivate(Value: Boolean); override;
  339.   protected
  340.     function GetClientType: TClientType;
  341.     procedure SetClientType(Value: TClientType);
  342.   public
  343.     constructor Create(AOwner: TComponent); override;
  344.     destructor Destroy; override;
  345.     property Socket: TClientWinSocket read FClientSocket;
  346.   published
  347.     property Active;
  348.     property Address;
  349.     property ClientType: TClientType read GetClientType write SetClientType;
  350.     property Host;
  351.     property Port;
  352.     property Service;
  353.     property OnLookup;
  354.     property OnConnecting;
  355.     property OnConnect;
  356.     property OnDisconnect;
  357.     property OnRead;
  358.     property OnWrite;
  359.     property OnError;
  360.   end;
  361.  
  362.   TCustomServerSocket = class(TCustomSocket)
  363.   private
  364.     procedure DoActivate(Value: Boolean); override;
  365.   protected
  366.     FServerSocket: TServerWinSocket;
  367.     function GetServerType: TServerType;
  368.     function GetGetThreadEvent: TGetThreadEvent;
  369.     function GetGetSocketEvent: TGetSocketEvent;
  370.     function GetThreadCacheSize: Integer;
  371.     function GetOnThreadStart: TThreadNotifyEvent;
  372.     function GetOnThreadEnd: TThreadNotifyEvent;
  373.     function GetOnClientEvent(Index: Integer): TSocketNotifyEvent;
  374.     function GetOnClientError: TSocketErrorEvent;
  375.     procedure SetServerType(Value: TServerType);
  376.     procedure SetGetThreadEvent(Value: TGetThreadEvent);
  377.     procedure SetGetSocketEvent(Value: TGetSocketEvent);
  378.     procedure SetThreadCacheSize(Value: Integer);
  379.     procedure SetOnThreadStart(Value: TThreadNotifyEvent);
  380.     procedure SetOnThreadEnd(Value: TThreadNotifyEvent);
  381.     procedure SetOnClientEvent(Index: Integer; Value: TSocketNotifyEvent);
  382.     procedure SetOnClientError(Value: TSocketErrorEvent);
  383.     property ServerType: TServerType read GetServerType write SetServerType;
  384.     property ThreadCacheSize: Integer read GetThreadCacheSize
  385.       write SetThreadCacheSize;
  386.     property OnGetThread: TGetThreadEvent read GetGetThreadEvent
  387.       write SetGetThreadEvent;
  388.     property OnGetSocket: TGetSocketEvent read GetGetSocketEvent
  389.       write SetGetSocketEvent;
  390.     property OnThreadStart: TThreadNotifyEvent read GetOnThreadStart
  391.       write SetOnThreadStart;
  392.     property OnThreadEnd: TThreadNotifyEvent read GetOnThreadEnd
  393.       write SetOnThreadEnd;
  394.     property OnClientConnect: TSocketNotifyEvent index 2 read GetOnClientEvent
  395.       write SetOnClientEvent;
  396.     property OnClientDisconnect: TSocketNotifyEvent index 3 read GetOnClientEvent
  397.       write SetOnClientEvent;
  398.     property OnClientRead: TSocketNotifyEvent index 0 read GetOnClientEvent
  399.       write SetOnClientEvent;
  400.     property OnClientWrite: TSocketNotifyEvent index 1 read GetOnClientEvent
  401.       write SetOnClientEvent;
  402.     property OnClientError: TSocketErrorEvent read GetOnClientError write SetOnClientError;
  403.   public
  404.     destructor Destroy; override;
  405.   end;
  406.  
  407.   TServerSocket = class(TCustomServerSocket)
  408.   public
  409.     constructor Create(AOwner: TComponent); override;
  410.     property Socket: TServerWinSocket read FServerSocket;
  411.   published
  412.     property Active;
  413.     property Port;
  414.     property Service;
  415.     property ServerType;
  416.     property ThreadCacheSize default 10;
  417.     property OnListen;
  418.     property OnAccept;
  419.     property OnGetThread;
  420.     property OnGetSocket;
  421.     property OnThreadStart;
  422.     property OnThreadEnd;
  423.     property OnClientConnect;
  424.     property OnClientDisconnect;
  425.     property OnClientRead;
  426.     property OnClientWrite;
  427.     property OnClientError;
  428.   end;
  429.  
  430. threadvar
  431.   SocketErrorProc: procedure (ErrorCode: Integer);
  432.  
  433. implementation
  434.  
  435. uses Forms, WebConst;
  436.  
  437. var
  438.   WSAData: TWSAData;
  439.  
  440. function CheckSocketResult(ResultCode: Integer; const Op: string): Integer;
  441. begin
  442.   if ResultCode <> 0 then
  443.   begin
  444.     Result := WSAGetLastError;
  445.     if Result <> WSAEWOULDBLOCK then
  446.       if Assigned(SocketErrorProc) then
  447.         SocketErrorProc(Result)
  448.       else raise ESocketError.CreateFmt(sWindowsSocketError,
  449.         [SysErrorMessage(Result), Result, Op]);
  450.   end else Result := 0;
  451. end;
  452.  
  453. procedure Startup;
  454. var
  455.   ErrorCode: Integer;
  456. begin
  457.   ErrorCode := WSAStartup($0101, WSAData);
  458.   if ErrorCode <> 0 then
  459.     raise ESocketError.CreateFmt(sWindowsSocketError,
  460.       [SysErrorMessage(ErrorCode), ErrorCode, 'WSAStartup']);
  461. end;
  462.  
  463. procedure Cleanup;
  464. var
  465.   ErrorCode: Integer;
  466. begin
  467.   ErrorCode := WSACleanup;
  468.   if ErrorCode <> 0 then
  469.     raise ESocketError.CreateFmt(sWindowsSocketError,
  470.       [SysErrorMessage(ErrorCode), ErrorCode, 'WSACleanup']);
  471. end;
  472.  
  473. { TCustomWinSocket }
  474.  
  475. constructor TCustomWinSocket.Create(ASocket: TSocket);
  476. begin
  477.   inherited Create;
  478.   Startup;
  479.   FSocketLock := TCriticalSection.Create;
  480.   FASyncStyles := [asRead, asWrite, asConnect, asClose];
  481.   FSocket := ASocket;
  482.   FAddr.sin_family := PF_INET;
  483.   FAddr.sin_addr.s_addr := INADDR_ANY;
  484.   FAddr.sin_port := 0;
  485.   FConnected := FSocket <> INVALID_SOCKET;
  486. end;
  487.  
  488. destructor TCustomWinSocket.Destroy;
  489. begin
  490.   FOnSocketEvent := nil;  { disable events }
  491.   if FConnected and (FSocket <> INVALID_SOCKET) then
  492.     Disconnect(FSocket);
  493.   if FHandle <> 0 then DeallocateHWnd(FHandle);
  494.   FSocketLock.Free;
  495.   Cleanup;
  496.   inherited Destroy;
  497. end;
  498.  
  499. procedure TCustomWinSocket.Accept(Socket: TSocket);
  500. begin
  501. end;
  502.  
  503. procedure TCustomWinSocket.Close;
  504. begin
  505.   Disconnect(FSocket);
  506. end;
  507.  
  508. procedure TCustomWinSocket.Connect(Socket: TSocket);
  509. begin
  510. end;
  511.  
  512. procedure TCustomWinSocket.Lock;
  513. begin
  514.   FSocketLock.Enter;
  515. end;
  516.  
  517. procedure TCustomWinSocket.Unlock;
  518. begin
  519.   FSocketLock.Leave;
  520. end;
  521.  
  522. procedure TCustomWinSocket.CMSocketMessage(var Message: TCMSocketMessage);
  523.  
  524.   function CheckError: Boolean;
  525.   var
  526.     ErrorEvent: TErrorEvent;
  527.     ErrorCode: Integer;
  528.   begin
  529.     if Message.SelectError <> 0 then
  530.     begin
  531.       Result := False;
  532.       ErrorCode := Message.SelectError;
  533.       case Message.SelectEvent of
  534.         FD_CONNECT: ErrorEvent := eeConnect;
  535.         FD_CLOSE: ErrorEvent := eeDisconnect;
  536.         FD_READ: ErrorEvent := eeReceive;
  537.         FD_WRITE: ErrorEvent := eeSend;
  538.         FD_ACCEPT: ErrorEvent := eeAccept;
  539.       else
  540.         ErrorEvent := eeGeneral;
  541.       end;
  542.       Error(Self, ErrorEvent, ErrorCode);
  543.       if ErrorCode <> 0 then
  544.         raise ESocketError.CreateFmt(sASyncSocketError, [ErrorCode]);
  545.     end else Result := True;
  546.   end;
  547.  
  548. begin
  549.   with Message do
  550.     if CheckError then
  551.       case SelectEvent of
  552.         FD_CONNECT: Connect(Socket);
  553.         FD_CLOSE: Disconnect(Socket);
  554.         FD_READ: Read(Socket);
  555.         FD_WRITE: Write(Socket);
  556.         FD_ACCEPT: Accept(Socket);
  557.       end;
  558. end;
  559.  
  560. procedure TCustomWinSocket.DoSetAsyncStyles;
  561. var
  562.   Msg: Integer;
  563.   Wnd: HWnd;
  564.   Blocking: Longint;
  565. begin
  566.   Msg := 0;
  567.   Wnd := 0;
  568.   if FAsyncStyles <> [] then
  569.   begin
  570.     Msg := CM_SOCKETMESSAGE;
  571.     Wnd := Handle;
  572.   end;
  573.   WSAAsyncSelect(FSocket, Wnd, Msg, Longint(Byte(FAsyncStyles)));
  574.   if FASyncStyles = [] then
  575.   begin
  576.     Blocking := 0;
  577.     ioctlsocket(FSocket, FIONBIO, Blocking);
  578.   end;
  579. end;
  580.  
  581. function TCustomWinSocket.GetHandle: HWnd;
  582. begin
  583.   if FHandle = 0 then
  584.     FHandle := AllocateHwnd(WndProc);
  585.   Result := FHandle;
  586. end;
  587.  
  588. function TCustomWinSocket.GetLocalAddress: string;
  589. var
  590.   SockAddrIn: TSockAddrIn;
  591.   Size: Integer;
  592. begin
  593.   Lock;
  594.   try
  595.     Result := '';
  596.     if FSocket = INVALID_SOCKET then Exit;
  597.     Size := SizeOf(SockAddrIn);
  598.     if getsockname(FSocket, SockAddrIn, Size) = 0 then
  599.       Result := inet_ntoa(SockAddrIn.sin_addr);
  600.   finally
  601.     Unlock;
  602.   end;
  603. end;
  604.  
  605. function TCustomWinSocket.GetLocalHost: string;
  606. var
  607.   LocalName: array[0..255] of Char;
  608. begin
  609.   Lock;
  610.   try
  611.     Result := '';
  612.     if FSocket = INVALID_SOCKET then Exit;
  613.     if gethostname(LocalName, SizeOf(LocalName)) = 0 then
  614.       Result := LocalName;
  615.   finally
  616.     Unlock;
  617.   end;
  618. end;
  619.  
  620. function TCustomWinSocket.GetLocalPort: Integer;
  621. var
  622.   SockAddrIn: TSockAddrIn;
  623.   Size: Integer;
  624. begin
  625.   Lock;
  626.   try
  627.     Result := -1;
  628.     if FSocket = INVALID_SOCKET then Exit;
  629.     Size := SizeOf(SockAddrIn);
  630.     if getsockname(FSocket, SockAddrIn, Size) = 0 then
  631.       Result := ntohs(SockAddrIn.sin_port);
  632.   finally
  633.     Unlock;
  634.   end;
  635. end;
  636.  
  637. function TCustomWinSocket.GetRemoteHost: string;
  638. var
  639.   SockAddrIn: TSockAddrIn;
  640.   Size: Integer;
  641.   HostEnt: PHostEnt;
  642. begin
  643.   Lock;
  644.   try
  645.     Result := '';
  646.     if not FConnected then Exit;
  647.     Size := SizeOf(SockAddrIn);
  648.     getpeername(FSocket, SockAddrIn, Size);
  649.     HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.s_addr, 4, PF_INET);
  650.     if HostEnt <> nil then Result := HostEnt.h_name;
  651.   finally
  652.     Unlock;
  653.   end;
  654. end;
  655.  
  656. function TCustomWinSocket.GetRemoteAddress: string;
  657. var
  658.   SockAddrIn: TSockAddrIn;
  659.   Size: Integer;
  660. begin
  661.   Lock;
  662.   try
  663.     Result := '';
  664.     if not FConnected then Exit;
  665.     Size := SizeOf(SockAddrIn);
  666.     if getpeername(FSocket, SockAddrIn, Size) = 0 then
  667.       Result := inet_ntoa(SockAddrIn.sin_addr);
  668.   finally
  669.     Unlock;
  670.   end;
  671. end;
  672.  
  673. function TCustomWinSocket.GetRemotePort: Integer;
  674. var
  675.   SockAddrIn: TSockAddrIn;
  676.   Size: Integer;
  677. begin
  678.   Lock;
  679.   try
  680.     Result := 0;
  681.     if not FConnected then Exit;
  682.     Size := SizeOf(SockAddrIn);
  683.     if getpeername(FSocket, SockAddrIn, Size) = 0 then
  684.       Result := ntohs(SockAddrIn.sin_port);
  685.   finally
  686.     Unlock;
  687.   end;
  688. end;
  689.  
  690. function TCustomWinSocket.GetRemoteAddr: TSockAddrIn;
  691. var
  692.   Size: Integer;
  693. begin
  694.   Lock;
  695.   try
  696.     FillChar(Result, SizeOf(Result), 0);
  697.     if not FConnected then Exit;
  698.     Size := SizeOf(Result);
  699.     if getpeername(FSocket, Result, Size) <> 0 then
  700.       FillChar(Result, SizeOf(Result), 0);
  701.   finally
  702.     Unlock;
  703.   end;
  704. end;
  705.  
  706. function TCustomWinSocket.LookupName(const Name: string): TInAddr;
  707. var
  708.   HostEnt: PHostEnt;
  709.   InAddr: TInAddr;
  710. begin
  711.   HostEnt := gethostbyname(PChar(Name));
  712.   FillChar(InAddr, SizeOf(InAddr), 0);
  713.   if HostEnt <> nil then
  714.   begin
  715.     with InAddr, HostEnt^ do
  716.     begin
  717.       S_un_b.s_b1 := h_addr^[0];
  718.       S_un_b.s_b2 := h_addr^[1];
  719.       S_un_b.s_b3 := h_addr^[2];
  720.       S_un_b.s_b4 := h_addr^[3];
  721.     end;
  722.   end;
  723.   Result := InAddr;
  724. end;
  725.  
  726. function TCustomWinSocket.LookupService(const Service: string): Integer;
  727. var
  728.   ServEnt: PServEnt;
  729. begin
  730.   ServEnt := getservbyname(PChar(Service), 'tcp');
  731.   if ServEnt <> nil then
  732.     Result := ServEnt.s_port
  733.   else Result := 0;
  734. end;
  735.  
  736. function TCustomWinSocket.InitSocket(var Name, Address, Service: string; Port: Word;
  737.   Client: Boolean): TSockAddrIn;
  738. begin
  739.   Result.sin_family := PF_INET;
  740.   if Name <> '' then
  741.     Result.sin_addr := LookupName(name)
  742.   else if Address <> '' then
  743.     Result.sin_addr.s_addr := inet_addr(PChar(Address))
  744.   else if not Client then
  745.     Result.sin_addr.s_addr := INADDR_ANY
  746.   else raise ESocketError.Create(sNoAddress);
  747.   if Service <> '' then
  748.     Result.sin_port := LookupService(Service)
  749.   else
  750.     Result.sin_port := htons(Port);
  751. end;
  752.  
  753. procedure TCustomWinSocket.Listen(var Name, Address, Service: string; Port: Word;
  754.   QueueSize: Integer);
  755. var
  756.   SockAddrIn: TSockAddrIn;
  757. begin
  758.   if FConnected then raise ESocketError.Create(sCannotListenOnOpen);
  759.   FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  760.   if FSocket = INVALID_SOCKET then raise ESocketError.Create(sCannotCreateSocket);
  761.   try
  762.     SockAddrIn := InitSocket(Name, Address, Service, Port, False);
  763.     CheckSocketResult(bind(FSocket, SockAddrIn, SizeOf(SockAddrIn)), 'bind');
  764.     DoSetASyncStyles;
  765.     if QueueSize > SOMAXCONN then QueueSize := SOMAXCONN;
  766.     Event(Self, seListen);
  767.     CheckSocketResult(Winsock.listen(FSocket, QueueSize), 'listen');
  768.     FConnected := True;
  769.   except
  770.     Disconnect(FSocket);
  771.     raise;
  772.   end;
  773. end;
  774.  
  775. procedure TCustomWinSocket.Open(var Name, Address, Service: string; Port: Word);
  776. var
  777.   SockAddrIn: TSockAddrIn;
  778. begin
  779.   if FConnected then raise ESocketError.Create(sSocketAlreadyOpen);
  780.   FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  781.   if FSocket = INVALID_SOCKET then raise ESocketError.Create(sCannotCreateSocket);
  782.   try
  783.     Event(Self, seLookUp);
  784.     SockAddrIn := InitSocket(Name, Address, Service, Port, True);
  785.     DoSetASyncStyles;
  786.     Event(Self, seConnecting);
  787.     CheckSocketResult(WinSock.connect(FSocket, SockAddrIn, SizeOf(SockAddrIn)), 'connect');
  788.     if not (asConnect in FAsyncStyles) then
  789.     begin
  790.       FConnected := FSocket <> INVALID_SOCKET;
  791.       Event(Self, seConnect);
  792.     end;
  793.   except
  794.     Disconnect(FSocket);
  795.     raise;
  796.   end;
  797. end;
  798.  
  799. procedure TCustomWinSocket.Disconnect(Socket: TSocket);
  800. begin
  801.   Lock;
  802.   try
  803.     if (Socket = INVALID_SOCKET) or (Socket <> FSocket) then exit;
  804.     Event(Self, seDisconnect);
  805.     CheckSocketResult(closesocket(FSocket), 'closesocket');
  806.     FSocket := INVALID_SOCKET;
  807.     FConnected := False;
  808.     FSendStream.Free;
  809.     FSendStream := nil;
  810.   finally
  811.     Unlock;
  812.   end;
  813. end;
  814.  
  815. procedure TCustomWinSocket.DefaultHandler(var Message);
  816. begin
  817.   with TMessage(Message) do
  818.     if FHandle <> 0 then
  819.       Result := CallWindowProc(@DefWindowProc, FHandle, Msg, wParam, lParam);
  820. end;
  821.  
  822. procedure TCustomWinSocket.Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
  823. begin
  824.   if Assigned(FOnSocketEvent) then FOnSocketEvent(Self, Socket, SocketEvent);
  825. end;
  826.  
  827. procedure TCustomWinSocket.Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  828.   var ErrorCode: Integer);
  829. begin
  830.   if Assigned(FOnErrorEvent) then FOnErrorEvent(Self, Socket, ErrorEvent, ErrorCode);
  831. end;
  832.  
  833. procedure TCustomWinSocket.SendText(const s: string);
  834. begin
  835.   SendBuf(Pointer(S)^, Length(S));
  836. end;
  837.  
  838. function TCustomWinSocket.SendStreamPiece: Boolean;
  839. var
  840.   Buffer: array[0..4095] of Byte;
  841.   StartPos: Integer;
  842.   AmountInBuf: Integer;
  843.   AmountSent: Integer;
  844.   ErrorCode: Integer;
  845.  
  846.   procedure DropStream;
  847.   begin
  848.     if FDropAfterSend then Disconnect(FSocket);
  849.     FDropAfterSend := False;
  850.     FSendStream.Free;
  851.     FSendStream := nil;
  852.   end;
  853.  
  854. begin
  855.   Lock;
  856.   try
  857.     Result := False;
  858.     if FSendStream <> nil then
  859.     begin
  860.       if (FSocket = INVALID_SOCKET) or (not FConnected) then exit;
  861.       while True do
  862.       begin
  863.         StartPos := FSendStream.Position;
  864.         AmountInBuf := FSendStream.Read(Buffer, SizeOf(Buffer));
  865.         if AmountInBuf > 0 then
  866.         begin
  867.           AmountSent := send(FSocket, Buffer, AmountInBuf, 0);
  868.           if AmountSent = SOCKET_ERROR then
  869.           begin
  870.             ErrorCode := WSAGetLastError;
  871.             if ErrorCode <> WSAEWOULDBLOCK then
  872.             begin
  873.               Error(Self, eeSend, ErrorCode);
  874.               Disconnect(FSocket);
  875.               DropStream;
  876.               if FAsyncStyles <> [] then Abort;
  877.               Break;
  878.             end else
  879.             begin
  880.               FSendStream.Position := StartPos;
  881.               Break;
  882.             end;
  883.           end else if AmountInBuf > AmountSent then
  884.             FSendStream.Position := StartPos + (AmountInBuf - AmountSent)
  885.           else if FSendStream.Position = FSendStream.Size then
  886.           begin
  887.             DropStream;
  888.             Break;
  889.           end;
  890.         end else
  891.         begin
  892.           DropStream;
  893.           Break;
  894.         end;
  895.       end;
  896.       Result := True;
  897.     end;
  898.   finally
  899.     Unlock;
  900.   end;
  901. end;
  902.  
  903. function TCustomWinSocket.SendStream(AStream: TStream): Boolean;
  904. begin
  905.   Result := False;
  906.   if FSendStream = nil then
  907.   begin
  908.     FSendStream := AStream;
  909.     Result := SendStreamPiece;
  910.   end;
  911. end;
  912.  
  913. function TCustomWinSocket.SendStreamThenDrop(AStream: TStream): Boolean;
  914. begin
  915.   FDropAfterSend := True;
  916.   Result := SendStream(AStream);
  917.   if not Result then FDropAfterSend := False;
  918. end;
  919.  
  920. function TCustomWinSocket.SendBuf(var Buf; Count: Integer): Integer;
  921. var
  922.   ErrorCode: Integer;
  923. begin
  924.   Lock;
  925.   try
  926.     Result := 0;
  927.     if not FConnected then Exit;
  928.     Result := send(FSocket, Buf, Count, 0);
  929.     if Result = SOCKET_ERROR then
  930.     begin
  931.       ErrorCode := WSAGetLastError;
  932.       if (ErrorCode <> WSAEWOULDBLOCK) then
  933.       begin
  934.         Error(Self, eeSend, ErrorCode);
  935.         Disconnect(FSocket);
  936.         if ErrorCode <> 0 then
  937.           raise ESocketError.CreateFmt(sWindowsSocketError,
  938.             [SysErrorMessage(ErrorCode), ErrorCode, 'send']);
  939.       end;
  940.     end;
  941.   finally
  942.     Unlock;
  943.   end;
  944. end;
  945.  
  946. procedure TCustomWinSocket.SetAsyncStyles(Value: TASyncStyles);
  947. begin
  948.   if Value <> FASyncStyles then
  949.   begin
  950.     FASyncStyles := Value;
  951.     if FSocket <> INVALID_SOCKET then
  952.       DoSetAsyncStyles;
  953.   end;
  954. end;
  955.  
  956. procedure TCustomWinSocket.Read(Socket: TSocket);
  957. begin
  958.   if (FSocket = INVALID_SOCKET) or (Socket <> FSocket) then Exit;
  959.   Event(Self, seRead);
  960. end;
  961.  
  962. function TCustomWinSocket.ReceiveBuf(var Buf; Count: Integer): Integer;
  963. var
  964.   ErrorCode: Integer;
  965. begin
  966.   Lock;
  967.   try
  968.     Result := 0;
  969.     if (Count = -1) and FConnected then
  970.       ioctlsocket(FSocket, FIONREAD, Longint(Result))
  971.     else begin
  972.       if not FConnected then Exit;
  973.       Result := recv(FSocket, Buf, Count, 0);
  974.       if Result = SOCKET_ERROR then
  975.       begin
  976.         ErrorCode := WSAGetLastError;
  977.         if ErrorCode <> WSAEWOULDBLOCK then
  978.         begin
  979.           Error(Self, eeReceive, ErrorCode);
  980.           Disconnect(FSocket);
  981.           if ErrorCode <> 0 then
  982.             raise ESocketError.CreateFmt(sWindowsSocketError,
  983.               [SysErrorMessage(ErrorCode), ErrorCode, 'recv']);
  984.         end;
  985.       end;
  986.     end;
  987.   finally
  988.     Unlock;
  989.   end;
  990. end;
  991.  
  992. function TCustomWinSocket.ReceiveLength: Integer;
  993. begin
  994.   Result := ReceiveBuf(Pointer(nil)^, -1);
  995. end;
  996.  
  997. function TCustomWinSocket.ReceiveText: string;
  998. begin
  999.   SetLength(Result, ReceiveBuf(Pointer(nil)^, -1));
  1000.   ReceiveBuf(Pointer(Result)^, Length(Result));
  1001. end;
  1002.  
  1003. procedure TCustomWinSocket.WndProc(var Message: TMessage);
  1004. begin
  1005.   try
  1006.     Dispatch(Message);
  1007.   except
  1008.     Application.HandleException(Self);
  1009.   end;
  1010. end;
  1011.  
  1012. procedure TCustomWinSocket.Write(Socket: TSocket);
  1013. begin
  1014.   if (FSocket = INVALID_SOCKET) or (Socket <> FSocket) then Exit;
  1015.   if not SendStreamPiece then Event(Self, seWrite);
  1016. end;
  1017.  
  1018. { TClientWinSocket }
  1019.  
  1020. procedure TClientWinSocket.Connect(Socket: TSocket);
  1021. begin
  1022.   Event(Self, seConnect);
  1023.   FConnected := True;
  1024. end;
  1025.  
  1026. procedure TClientWinSocket.SetClientType(Value: TClientType);
  1027. begin
  1028.   if Value <> FClientType then
  1029.     if not FConnected then
  1030.     begin
  1031.       FClientType := Value;
  1032.       if FClientType = ctBlocking then
  1033.         ASyncStyles := []
  1034.       else ASyncStyles := [asRead, asWrite, asConnect, asClose];
  1035.     end else raise ESocketError.Create(sCantChangeWhileActive);
  1036. end;
  1037.  
  1038. { TServerClientWinsocket }
  1039.  
  1040. constructor TServerClientWinSocket.Create(Socket: TSocket; ServerWinSocket: TServerWinSocket);
  1041. begin
  1042.   FServerWinSocket := ServerWinSocket;
  1043.   if Assigned(FServerWinSocket) then
  1044.   begin
  1045.     FServerWinSocket.AddClient(Self);
  1046.     if FServerWinSocket.AsyncStyles <> [] then
  1047.       OnSocketEvent := FServerWinSocket.ClientEvent;
  1048.   end;
  1049.   inherited Create(Socket);
  1050.   if FServerWinSocket.ASyncStyles <> [] then DoSetAsyncStyles;
  1051.   if FConnected then Event(Self, seConnect);
  1052. end;
  1053.  
  1054. destructor TServerClientWinSocket.Destroy;
  1055. begin
  1056.   if Assigned(FServerWinSocket) then
  1057.     FServerWinSocket.RemoveClient(Self);
  1058.   inherited Destroy;
  1059. end;
  1060.  
  1061. { TServerWinSocket }
  1062.  
  1063. constructor TServerWinSocket.Create(ASocket: TSocket);
  1064. begin
  1065.   FConnections := TList.Create;
  1066.   FActiveThreads := TList.Create;
  1067.   FListLock := TCriticalSection.Create;
  1068.   inherited Create(ASocket);
  1069.   FAsyncStyles := [asAccept];
  1070. end;
  1071.  
  1072. destructor TServerWinSocket.Destroy;
  1073. begin
  1074.   inherited Destroy;
  1075.   FConnections.Free;
  1076.   FActiveThreads.Free;
  1077.   FListLock.Free;
  1078. end;
  1079.  
  1080. procedure TServerWinSocket.AddClient(AClient: TServerClientWinSocket);
  1081. begin
  1082.   FListLock.Enter;
  1083.   try
  1084.     if FConnections.IndexOf(AClient) < 0 then
  1085.       FConnections.Add(AClient);
  1086.   finally
  1087.     FListLock.Leave;
  1088.   end;
  1089. end;
  1090.  
  1091. procedure TServerWinSocket.RemoveClient(AClient: TServerClientWinSocket);
  1092. begin
  1093.   FListLock.Enter;
  1094.   try
  1095.     FConnections.Remove(AClient);
  1096.   finally
  1097.     FListLock.Leave;
  1098.   end;
  1099. end;
  1100.  
  1101. procedure TServerWinSocket.AddThread(AThread: TServerClientThread);
  1102. begin
  1103.   FListLock.Enter;
  1104.   try
  1105.     if FActiveThreads.IndexOf(AThread) < 0 then
  1106.     begin
  1107.       FActiveThreads.Add(AThread);
  1108.       if FActiveThreads.Count <= FThreadCacheSize then
  1109.         AThread.KeepInCache := True;
  1110.     end;
  1111.   finally
  1112.     FListLock.Leave;
  1113.   end;
  1114. end;
  1115.  
  1116. procedure TServerWinSocket.RemoveThread(AThread: TServerClientThread);
  1117. begin
  1118.   FListLock.Enter;
  1119.   try
  1120.     FActiveThreads.Remove(AThread);
  1121.   finally
  1122.     FListLock.Leave;
  1123.   end;
  1124. end;
  1125.  
  1126. procedure TServerWinSocket.ClientEvent(Sender: TObject; Socket: TCustomWinSocket;
  1127.   SocketEvent: TSocketEvent);
  1128. begin
  1129.   case SocketEvent of
  1130.     seAccept,
  1131.     seLookup,
  1132.     seConnecting,
  1133.     seListen:
  1134.       begin end;
  1135.     seConnect: ClientConnect(Socket);
  1136.     seDisconnect: ClientDisconnect(Socket);
  1137.     seRead: ClientRead(Socket);
  1138.     seWrite: ClientWrite(Socket);
  1139.   end;
  1140. end;
  1141.  
  1142. procedure TServerWinSocket.ClientError(Sender: TObject; Socket: TCustomWinSocket;
  1143.   ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  1144. begin
  1145.   ClientErrorEvent(Socket, ErrorEvent, ErrorCode);
  1146. end;
  1147.  
  1148. function TServerWinSocket.GetActiveConnections: Integer;
  1149. begin
  1150.   Result := FConnections.Count;
  1151. end;
  1152.  
  1153. function TServerWinSocket.GetConnections(Index: Integer): TCustomWinSocket;
  1154. begin
  1155.   Result := FConnections[Index];
  1156. end;
  1157.  
  1158. function TServerWinSocket.GetActiveThreads: Integer;
  1159. var
  1160.   I: Integer;
  1161. begin
  1162.   FListLock.Enter;
  1163.   try
  1164.     Result := 0;
  1165.     for I := 0 to FActiveThreads.Count - 1 do
  1166.       if TServerClientThread(FActiveThreads[I]).ClientSocket <> nil then
  1167.         Inc(Result);
  1168.   finally
  1169.     FListLock.Leave;
  1170.   end;
  1171. end;
  1172.  
  1173. function TServerWinSocket.GetIdleThreads: Integer;
  1174. var
  1175.   I: Integer;
  1176. begin
  1177.   FListLock.Enter;
  1178.   try
  1179.     Result := 0;
  1180.     for I := 0 to FActiveThreads.Count - 1 do
  1181.       if TServerClientThread(FActiveThreads[I]).ClientSocket = nil then
  1182.         Inc(Result);
  1183.   finally
  1184.     FListLock.Leave;
  1185.   end;
  1186. end;
  1187.  
  1188. procedure TServerWinSocket.Accept(Socket: TSocket);
  1189. var
  1190.   ClientSocket: TServerClientWinSocket;
  1191.   ClientWinSocket: TSocket;
  1192.   Addr: TSockAddrIn;
  1193.   Len: Integer;
  1194.   OldOpenType, NewOpenType: Integer;
  1195. begin
  1196.   Len := SizeOf(OldOpenType);
  1197.   if getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@OldOpenType),
  1198.     Len) = 0 then
  1199.   try
  1200.     if FServerType = stThreadBlocking then
  1201.     begin
  1202.       NewOpenType := SO_SYNCHRONOUS_NONALERT;
  1203.       setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@NewOpenType), Len);
  1204.     end;
  1205.     Len := SizeOf(Addr);
  1206.     ClientWinSocket := WinSock.accept(Socket, @Addr, @Len);
  1207.     if ClientWinSocket <> INVALID_SOCKET then
  1208.     begin
  1209.       ClientSocket := GetClientSocket(ClientWinSocket);
  1210.       if Assigned(FOnSocketEvent) then
  1211.         FOnSocketEvent(Self, ClientSocket, seAccept);
  1212.       if FServerType = stThreadBlocking then
  1213.       begin
  1214.         ClientSocket.ASyncStyles := [];
  1215.         GetServerThread(ClientSocket);
  1216.       end;
  1217.     end;
  1218.   finally
  1219.     Len := SizeOf(OldOpenType);
  1220.     setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@OldOpenType), Len);
  1221.   end;
  1222. end;
  1223.  
  1224. procedure TServerWinSocket.Disconnect(Socket: TSocket);
  1225. var
  1226.   SaveCacheSize: Integer;
  1227. begin
  1228.   Lock;
  1229.   try
  1230.     SaveCacheSize := ThreadCacheSize;
  1231.     try
  1232.       ThreadCacheSize := 0;
  1233.       while FActiveThreads.Count > 0 do
  1234.         with TServerClientThread(FActiveThreads.Last) do
  1235.         begin
  1236.           FreeOnTerminate := False;
  1237.           Terminate;
  1238.           FEvent.SetEvent;
  1239.           if (ClientSocket <> nil) and ClientSocket.Connected then
  1240.             ClientSocket.Close;
  1241.           Free;
  1242.         end;
  1243.       while FConnections.Count > 0 do
  1244.         TCustomWinSocket(FConnections.Last).Free;
  1245.       if FServerAcceptThread <> nil then
  1246.         FServerAcceptThread.Terminate;
  1247.       inherited Disconnect(Socket);
  1248.       FServerAcceptThread.Free;
  1249.       FServerAcceptThread := nil;
  1250.     finally
  1251.       ThreadCacheSize := SaveCacheSize;
  1252.     end;
  1253.   finally
  1254.     Unlock;
  1255.   end;
  1256. end;
  1257.  
  1258. function TServerWinSocket.DoCreateThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
  1259. begin
  1260.   Result := TServerClientThread.Create(False, ClientSocket);
  1261. end;
  1262.  
  1263. procedure TServerWinSocket.Listen(var Name, Address, Service: string; Port: Word;
  1264.   QueueSize: Integer);
  1265. begin
  1266.   inherited Listen(Name, Address, Service, Port, QueueSize);
  1267.   if FConnected and (ServerType = stThreadBlocking) then
  1268.     FServerAcceptThread := TServerAcceptThread.Create(False, Self);
  1269. end;
  1270.  
  1271. procedure TServerWinSocket.SetServerType(Value: TServerType);
  1272. begin
  1273.   if Value <> FServerType then
  1274.     if not FConnected then
  1275.     begin
  1276.       FServerType := Value;
  1277.       if FServerType = stThreadBlocking then
  1278.         ASyncStyles := []
  1279.       else ASyncStyles := [asAccept];
  1280.     end else raise ESocketError.Create(sCantChangeWhileActive);
  1281. end;
  1282.  
  1283. procedure TServerWinSocket.SetThreadCacheSize(Value: Integer);
  1284. var
  1285.   Start, I: Integer;
  1286. begin
  1287.   if Value <> FThreadCacheSize then
  1288.   begin
  1289.     if Value < FThreadCacheSize then
  1290.       Start := Value
  1291.     else Start := FThreadCacheSize;
  1292.     FThreadCacheSize := Value;
  1293.     FListLock.Enter;
  1294.     try
  1295.       for I := 0 to FActiveThreads.Count - 1 do
  1296.         with TServerClientThread(FActiveThreads[I]) do
  1297.           KeepInCache := I < Start;
  1298.     finally
  1299.       FListLock.Leave;
  1300.     end;
  1301.   end;
  1302. end;
  1303.  
  1304. function TServerWinSocket.GetClientSocket(Socket: TSocket): TServerClientWinSocket;
  1305. begin
  1306.   Result := nil;
  1307.   if Assigned(FOnGetSocket) then FOnGetSocket(Self, Socket, Result);
  1308.   if Result = nil then
  1309.     Result := TServerClientWinSocket.Create(Socket, Self);
  1310. end;
  1311.  
  1312. procedure TServerWinSocket.ThreadEnd(AThread: TServerClientThread);
  1313. begin
  1314.   if Assigned(FOnThreadEnd) then FOnThreadEnd(Self, AThread);
  1315. end;
  1316.  
  1317. procedure TServerWinSocket.ThreadStart(AThread: TServerClientThread);
  1318. begin
  1319.   if Assigned(FOnThreadStart) then FOnThreadStart(Self, AThread);
  1320. end;
  1321.  
  1322. function TServerWinSocket.GetServerThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
  1323. var
  1324.   I: Integer;
  1325. begin
  1326.   Result := nil;
  1327.   FListLock.Enter;
  1328.   try
  1329.     for I := 0 to FActiveThreads.Count - 1 do
  1330.       if TServerClientThread(FActiveThreads[I]).ClientSocket = nil then
  1331.       begin
  1332.         Result := FActiveThreads[I];
  1333.         Result.ReActivate(ClientSocket);
  1334.         Break;
  1335.       end;
  1336.   finally
  1337.     FListLock.Leave;
  1338.   end;
  1339.   if Result = nil then
  1340.   begin
  1341.     if Assigned(FOnGetThread) then FOnGetThread(Self, ClientSocket, Result);
  1342.     if Result = nil then Result := DoCreateThread(ClientSocket);
  1343.   end;
  1344. end;
  1345.  
  1346. function TServerWinSocket.GetClientThread(ClientSocket: TServerClientWinSocket): TServerClientThread;
  1347. var
  1348.   I: Integer;
  1349. begin
  1350.   Result := nil;
  1351.   FListLock.Enter;
  1352.   try
  1353.     for I := 0 to FActiveThreads.Count - 1 do
  1354.       if TServerClientThread(FActiveThreads[I]).ClientSocket = ClientSocket then
  1355.       begin
  1356.         Result := FActiveThreads[I];
  1357.         Break;
  1358.       end;
  1359.   finally
  1360.     FListLock.Leave;
  1361.   end;
  1362. end;
  1363.  
  1364. procedure TServerWinSocket.ClientConnect(Socket: TCustomWinSocket);
  1365. begin
  1366.   if Assigned(FOnClientConnect) then FOnClientConnect(Self, Socket);
  1367. end;
  1368.  
  1369. procedure TServerWinSocket.ClientDisconnect(Socket: TCustomWinSocket);
  1370. begin
  1371.   if Assigned(FOnClientDisconnect) then FOnClientDisconnect(Self, Socket);
  1372. end;
  1373.  
  1374. procedure TServerWinSocket.ClientRead(Socket: TCustomWinSocket);
  1375. begin
  1376.   if Assigned(FOnClientRead) then FOnClientRead(Self, Socket);
  1377. end;
  1378.  
  1379. procedure TServerWinSocket.ClientWrite(Socket: TCustomWinSocket);
  1380. begin
  1381.   if Assigned(FOnClientWrite) then FOnClientWrite(Self, Socket);
  1382. end;
  1383.  
  1384. procedure TServerWinSocket.ClientErrorEvent(Socket: TCustomWinSocket;
  1385.   ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  1386. begin
  1387.   if Assigned(FOnClientError) then FOnClientError(Self, Socket, ErrorEvent, ErrorCode);
  1388. end;
  1389.  
  1390. { TServerAcceptThread }
  1391.  
  1392. constructor TServerAcceptThread.Create(CreateSuspended: Boolean;
  1393.   ASocket: TServerWinSocket);
  1394. begin
  1395.   FServerSocket := ASocket;
  1396.   inherited Create(CreateSuspended);
  1397. end;
  1398.  
  1399. procedure TServerAcceptThread.Execute;
  1400. begin
  1401.   while not Terminated do
  1402.     FServerSocket.Accept(FServerSocket.SocketHandle);
  1403. end;
  1404.  
  1405. { TServerClientThread }
  1406.  
  1407. constructor TServerClientThread.Create(CreateSuspended: Boolean;
  1408.   ASocket: TServerClientWinSocket);
  1409. begin
  1410.   FreeOnTerminate := True;
  1411.   FEvent := TSimpleEvent.Create;
  1412.   Priority := tpHigher;
  1413.   inherited Create(True);
  1414.   ReActivate(ASocket);
  1415.   if not CreateSuspended then Resume;
  1416. end;
  1417.  
  1418. destructor TServerClientThread.Destroy;
  1419. begin
  1420.   FClientSocket.Free;
  1421.   FEvent.Free;
  1422.   inherited Destroy;
  1423. end;
  1424.  
  1425. procedure TServerClientThread.ReActivate(ASocket: TServerClientWinSocket);
  1426. begin
  1427.   FClientSocket := ASocket;
  1428.   if Assigned(FClientSocket) then
  1429.   begin
  1430.     FServerSocket := FClientSocket.ServerWinSocket;
  1431.     FServerSocket.AddThread(Self);
  1432.     FClientSocket.OnSocketEvent := HandleEvent;
  1433.     FClientSocket.OnErrorEvent := HandleError;
  1434.     FEvent.SetEvent;
  1435.   end;
  1436. end;
  1437.  
  1438. procedure TServerClientThread.DoHandleException;
  1439. begin
  1440.   if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  1441.   if FException is Exception then
  1442.   begin
  1443.     Application.ShowException(FException);
  1444.   end else
  1445.     SysUtils.ShowException(FException, nil);
  1446. end;
  1447.  
  1448. procedure TServerClientThread.DoRead;
  1449. begin
  1450.   ClientSocket.ServerWinSocket.Event(ClientSocket, seRead);
  1451. end;
  1452.  
  1453. procedure TServerClientThread.DoTerminate;
  1454. begin
  1455.   if Assigned(FServerSocket) then
  1456.     FServerSocket.RemoveThread(Self);
  1457. end;
  1458.  
  1459. procedure TServerClientThread.DoWrite;
  1460. begin
  1461.   FServerSocket.Event(ClientSocket, seWrite);
  1462. end;
  1463.  
  1464. procedure TServerClientThread.HandleEvent(Sender: TObject; Socket: TCustomWinSocket;
  1465.   SocketEvent: TSocketEvent);
  1466. begin
  1467.   Event(SocketEvent);
  1468. end;
  1469.  
  1470. procedure TServerClientThread.HandleError(Sender: TObject; Socket: TCustomWinSocket;
  1471.   ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  1472. begin
  1473.   Error(ErrorEvent, ErrorCode);
  1474. end;
  1475.  
  1476. procedure TServerClientThread.Event(SocketEvent: TSocketEvent);
  1477. begin
  1478.   FServerSocket.ClientEvent(Self, ClientSocket, SocketEvent);
  1479. end;
  1480.  
  1481. procedure TServerClientThread.Error(ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  1482. begin
  1483.   FServerSocket.ClientError(Self, ClientSocket, ErrorEvent, ErrorCode);
  1484. end;
  1485.  
  1486. procedure TServerClientThread.HandleException;
  1487. begin
  1488.   FException := Exception(ExceptObject);
  1489.   try
  1490.     if not (FException is EAbort) then
  1491.       Synchronize(DoHandleException);
  1492.   finally
  1493.     FException := nil;
  1494.   end;
  1495. end;
  1496.  
  1497. procedure TServerClientThread.Execute;
  1498. begin
  1499.   FServerSocket.ThreadStart(Self);
  1500.   try
  1501.     try
  1502.       while True do
  1503.       begin
  1504.         if StartConnect then ClientExecute;
  1505.         if EndConnect then Break;
  1506.       end;
  1507.     except
  1508.       HandleException;
  1509.       KeepInCache := False;
  1510.     end;
  1511.   finally
  1512.     FServerSocket.ThreadEnd(Self);
  1513.   end;
  1514. end;
  1515.  
  1516. procedure TServerClientThread.ClientExecute;
  1517. var
  1518.   FDSet: TFDSet;
  1519.   TimeVal: TTimeVal;
  1520. begin
  1521.   while not Terminated and ClientSocket.Connected do
  1522.   begin
  1523.     FD_ZERO(FDSet);
  1524.     FD_SET(ClientSocket.SocketHandle, FDSet);
  1525.     TimeVal.tv_sec := 0;
  1526.     TimeVal.tv_usec := 500;
  1527.     if (select(0, @FDSet, nil, nil, @TimeVal) > 0) and not Terminated then
  1528.       if ClientSocket.ReceiveBuf(FDSet, -1) = 0 then Break
  1529.       else Synchronize(DoRead);
  1530.     if (select(0, nil, @FDSet, nil, @TimeVal) > 0) and not Terminated then
  1531.       Synchronize(DoWrite);
  1532.   end;
  1533. end;
  1534.  
  1535. function TServerClientThread.StartConnect: Boolean;
  1536. begin
  1537.   if FEvent.WaitFor(INFINITE) = wrSignaled then
  1538.     FEvent.ResetEvent;
  1539.   Result := not Terminated;
  1540. end;
  1541.  
  1542. function TServerClientThread.EndConnect: Boolean;
  1543. begin
  1544.   FClientSocket.Free;
  1545.   FClientSocket := nil;
  1546.   Result := Terminated or not KeepInCache;
  1547. end;
  1548.  
  1549. { TCustomSocket }
  1550.  
  1551. procedure TCustomSocket.DoEvent(Sender: TObject; Socket: TCustomWinSocket;
  1552.   SocketEvent: TSocketEvent);
  1553. begin
  1554.   Event(Socket, SocketEvent);
  1555. end;
  1556.  
  1557. procedure TCustomSocket.DoError(Sender: TObject; Socket: TCustomWinSocket;
  1558.   ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  1559. begin
  1560.   Error(Socket, ErrorEvent, ErrorCode);
  1561. end;
  1562.  
  1563. procedure TCustomSocket.Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
  1564. begin
  1565.   case SocketEvent of
  1566.     seLookup: if Assigned(FOnLookup) then FOnLookup(Self, Socket);
  1567.     seConnecting: if Assigned(FOnConnecting) then FOnConnecting(Self, Socket);
  1568.     seConnect:
  1569.       begin
  1570.         FActive := True;
  1571.         if Assigned(FOnConnect) then FOnConnect(Self, Socket);
  1572.       end;
  1573.     seListen: if Assigned(FOnListen) then FOnListen(Self, Socket);
  1574.     seDisconnect:
  1575.       begin
  1576.         FActive := False;
  1577.         if Assigned(FOnDisconnect) then FOnDisconnect(Self, Socket);
  1578.       end;
  1579.     seAccept: if Assigned(FOnAccept) then FOnAccept(Self, Socket);
  1580.     seRead: if Assigned(FOnRead) then FOnRead(Self, Socket);
  1581.     seWrite: if Assigned(FOnWrite) then FOnWrite(Self, Socket);
  1582.   end;
  1583. end;
  1584.  
  1585. procedure TCustomSocket.Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  1586.   var ErrorCode: Integer);
  1587. begin
  1588.   if Assigned(FOnError) then FOnError(Self, Socket, ErrorEvent, ErrorCode);
  1589. end;
  1590.  
  1591. procedure TCustomSocket.SetActive(Value: Boolean);
  1592. begin
  1593.   if Value <> FActive then
  1594.   begin
  1595.     if (csDesigning in ComponentState) or (csLoading in ComponentState) then
  1596.       FActive := Value;
  1597.     if not (csLoading in ComponentState) then
  1598.       DoActivate(Value);
  1599.   end;
  1600. end;
  1601.  
  1602. procedure TCustomSocket.Loaded;
  1603. begin
  1604.   inherited Loaded;
  1605.   DoActivate(FActive);
  1606. end;
  1607.  
  1608. procedure TCustomSocket.SetAddress(Value: string);
  1609. begin
  1610.   if CompareText(Value, FAddress) <> 0 then
  1611.   begin
  1612.     if not (csLoading in ComponentState) and FActive then
  1613.       raise ESocketError.Create(sCantChangeWhileActive);
  1614.     FAddress := Value;
  1615.   end;
  1616. end;
  1617.  
  1618. procedure TCustomSocket.SetHost(Value: string);
  1619. begin
  1620.   if CompareText(Value, FHost) <> 0 then
  1621.   begin
  1622.     if not (csLoading in ComponentState) and FActive then
  1623.       raise ESocketError.Create(sCantChangeWhileActive);
  1624.     FHost := Value;
  1625.   end;
  1626. end;
  1627.  
  1628. procedure TCustomSocket.SetPort(Value: Integer);
  1629. begin
  1630.   if FPort <> Value then
  1631.   begin
  1632.     if not (csLoading in ComponentState) and FActive then
  1633.       raise ESocketError.Create(sCantChangeWhileActive);
  1634.     FPort := Value;
  1635.   end;
  1636. end;
  1637.  
  1638. procedure TCustomSocket.SetService(Value: string);
  1639. begin
  1640.   if CompareText(Value, FService) <> 0 then
  1641.   begin
  1642.     if not (csLoading in ComponentState) and FActive then
  1643.       raise ESocketError.Create(sCantChangeWhileActive);
  1644.     FService := Value;
  1645.   end;
  1646. end;
  1647.  
  1648. procedure TCustomSocket.Open;
  1649. begin
  1650.   Active := True;
  1651. end;
  1652.  
  1653. procedure TCustomSocket.Close;
  1654. begin
  1655.   Active := False;
  1656. end;
  1657.  
  1658. { TWinSocketStream }
  1659.  
  1660. constructor TWinSocketStream.Create(ASocket: TCustomWinSocket; TimeOut: Longint);
  1661. begin
  1662.   if ASocket.ASyncStyles <> [] then
  1663.     raise ESocketError.Create(sSocketMustBeBlocking);
  1664.   FSocket := ASocket;
  1665.   FTimeOut := TimeOut;
  1666.   FEvent := TSimpleEvent.Create;
  1667.   inherited Create;
  1668. end;
  1669.  
  1670. destructor TWinSocketStream.Destroy;
  1671. begin
  1672.   FEvent.Free;
  1673.   inherited Destroy;
  1674. end;
  1675.  
  1676. function TWinSocketStream.WaitForData(Timeout: Longint): Boolean;
  1677. var
  1678.   FDSet: TFDSet;
  1679.   TimeVal: TTimeVal;
  1680. begin
  1681.   TimeVal.tv_sec := Timeout div 1000;
  1682.   TimeVal.tv_usec := (Timeout mod 1000) * 1000;
  1683.   FD_ZERO(FDSet);
  1684.   FD_SET(FSocket.SocketHandle, FDSet);
  1685.   Result := select(0, @FDSet, nil, nil, @TimeVal) > 0;
  1686. end;
  1687.  
  1688. function TWinSocketStream.Read(var Buffer; Count: Longint): Longint;
  1689. var
  1690.   Overlapped: TOverlapped;
  1691. begin
  1692.   FSocket.Lock;
  1693.   try
  1694.     FillChar(OVerlapped, SizeOf(Overlapped), 0);
  1695.     Overlapped.hEvent := FEvent.Handle;
  1696.     if not ReadFile(FSocket.SocketHandle, Buffer, Count, Integer(Result),
  1697.       @Overlapped) and (GetLastError <> ERROR_IO_PENDING) then
  1698.       raise ESocketError.CreateFmt(sSocketIOError, [sSocketRead, GetLastError]);
  1699.     if FEvent.WaitFor(FTimeOut) <> wrSignaled then
  1700.       Result := 0
  1701.     else
  1702.     begin
  1703.       GetOverlappedResult(FSocket.SocketHandle, Overlapped, Integer(Result), False);
  1704.       FEvent.ResetEvent;
  1705.     end;
  1706.   finally
  1707.     FSocket.Unlock;
  1708.   end;
  1709. end;
  1710.  
  1711. function TWinSocketStream.Write(const Buffer; Count: Longint): Longint;
  1712. var
  1713.   Overlapped: TOverlapped;
  1714. begin
  1715.   FSocket.Lock;
  1716.   try
  1717.     FillChar(OVerlapped, SizeOf(Overlapped), 0);
  1718.     Overlapped.hEvent := FEvent.Handle;
  1719.     if not WriteFile(FSocket.SocketHandle, Buffer, Count, Integer(Result),
  1720.       @Overlapped) and (GetLastError <> ERROR_IO_PENDING) then
  1721.       raise ESocketError.CreateFmt(sSocketIOError, [sSocketWrite, GetLastError]);
  1722.     if FEvent.WaitFor(FTimeOut) <> wrSignaled then
  1723.       Result := 0
  1724.     else GetOverlappedResult(FSocket.SocketHandle, Overlapped, Integer(Result), False);
  1725.   finally
  1726.     FSocket.Unlock;
  1727.   end;
  1728. end;
  1729.  
  1730. function TWinSocketStream.Seek(Offset: Longint; Origin: Word): Longint;
  1731. begin
  1732.   Result := 0;
  1733. end;
  1734.  
  1735. { TClientSocket }
  1736.  
  1737. constructor TClientSocket.Create(AOwner: TComponent);
  1738. begin
  1739.   inherited Create(AOwner);
  1740.   FClientSocket := TClientWinSocket.Create(INVALID_SOCKET);
  1741.   FClientSocket.OnSocketEvent := DoEvent;
  1742.   FClientSocket.OnErrorEvent := DoError;
  1743. end;
  1744.  
  1745. destructor TClientSocket.Destroy;
  1746. begin
  1747.   FClientSocket.Free;
  1748.   inherited Destroy;
  1749. end;
  1750.  
  1751. procedure TClientSocket.DoActivate(Value: Boolean);
  1752. begin
  1753.   if (Value <> FClientSocket.Connected) and not (csDesigning in ComponentState) then
  1754.   begin
  1755.     if FClientSocket.Connected then
  1756.       FClientSocket.Disconnect(FClientSocket.FSocket)
  1757.     else FClientSocket.Open(FHost, FAddress, FService, FPort);
  1758.   end;
  1759. end;
  1760.  
  1761. function TClientSocket.GetClientType: TClientType;
  1762. begin
  1763.   Result := FClientSocket.ClientType;
  1764. end;
  1765.  
  1766. procedure TClientSocket.SetClientType(Value: TClientType);
  1767. begin
  1768.   FClientSocket.ClientType := Value;
  1769. end;
  1770.  
  1771. { TCustomServerSocket }
  1772.  
  1773. destructor TCustomServerSocket.Destroy;
  1774. begin
  1775.   FServerSocket.Free;
  1776.   inherited Destroy;
  1777. end;
  1778.  
  1779. procedure TCustomServerSocket.DoActivate(Value: Boolean);
  1780. begin
  1781.   if (Value <> FServerSocket.Connected) and not (csDesigning in ComponentState) then
  1782.   begin
  1783.     if FServerSocket.Connected then
  1784.       FServerSocket.Disconnect(FServerSocket.SocketHandle)
  1785.     else FServerSocket.Listen(FHost, FAddress, FService, FPort, 5);
  1786.   end;
  1787. end;
  1788.  
  1789. function TCustomServerSocket.GetServerType: TServerType;
  1790. begin
  1791.   Result := FServerSocket.ServerType;
  1792. end;
  1793.  
  1794. procedure TCustomServerSocket.SetServerType(Value: TServerType);
  1795. begin
  1796.   FServerSocket.ServerType := Value;
  1797. end;
  1798.  
  1799. function TCustomServerSocket.GetGetThreadEvent: TGetThreadEvent;
  1800. begin
  1801.   Result := FServerSocket.OnGetThread;
  1802. end;
  1803.  
  1804. procedure TCustomServerSocket.SetGetThreadEvent(Value: TGetThreadEvent);
  1805. begin
  1806.   FServerSocket.OnGetThread := Value;
  1807. end;
  1808.  
  1809. function TCustomServerSocket.GetGetSocketEvent: TGetSocketEvent;
  1810. begin
  1811.   Result := FServerSocket.OnGetSocket;
  1812. end;
  1813.  
  1814. procedure TCustomServerSocket.SetGetSocketEvent(Value: TGetSocketEvent);
  1815. begin
  1816.   FServerSocket.OnGetSocket := Value;
  1817. end;
  1818.  
  1819. function TCustomServerSocket.GetThreadCacheSize: Integer;
  1820. begin
  1821.   Result := FServerSocket.ThreadCacheSize;
  1822. end;
  1823.  
  1824. procedure TCustomServerSocket.SetThreadCacheSize(Value: Integer);
  1825. begin
  1826.   FServerSocket.ThreadCacheSize := Value;
  1827. end;
  1828.  
  1829. function TCustomServerSocket.GetOnThreadStart: TThreadNotifyEvent;
  1830. begin
  1831.   Result := FServerSocket.OnThreadStart;
  1832. end;
  1833.  
  1834. function TCustomServerSocket.GetOnThreadEnd: TThreadNotifyEvent;
  1835. begin
  1836.   Result := FServerSocket.OnThreadEnd;
  1837. end;
  1838.  
  1839. procedure TCustomServerSocket.SetOnThreadStart(Value: TThreadNotifyEvent);
  1840. begin
  1841.   FServerSocket.OnThreadStart := Value;
  1842. end;
  1843.  
  1844. procedure TCustomServerSocket.SetOnThreadEnd(Value: TThreadNotifyEvent);
  1845. begin
  1846.   FServerSocket.OnThreadEnd := Value;
  1847. end;
  1848.  
  1849. function TCustomServerSocket.GetOnClientEvent(Index: Integer): TSocketNotifyEvent;
  1850. begin
  1851.   case Index of
  1852.     0: Result := FServerSocket.OnClientRead;
  1853.     1: Result := FServerSocket.OnClientWrite;
  1854.     2: Result := FServerSocket.OnClientConnect;
  1855.     3: Result := FServerSocket.OnClientDisconnect;
  1856.   end;
  1857. end;
  1858.  
  1859. procedure TCustomServerSocket.SetOnClientEvent(Index: Integer;
  1860.   Value: TSocketNotifyEvent);
  1861. begin
  1862.   case Index of
  1863.     0: FServerSocket.OnClientRead := Value;
  1864.     1: FServerSocket.OnClientWrite := Value;
  1865.     2: FServerSocket.OnClientConnect := Value;
  1866.     3: FServerSocket.OnClientDisconnect := Value;
  1867.   end;
  1868. end;
  1869.  
  1870. function TCustomServerSocket.GetOnClientError: TSocketErrorEvent;
  1871. begin
  1872.   Result := FServerSocket.OnClientError;
  1873. end;
  1874.  
  1875. procedure TCustomServerSocket.SetOnClientError(Value: TSocketErrorEvent);
  1876. begin
  1877.   FServerSocket.OnClientError := Value;
  1878. end;
  1879.  
  1880. { TServerSocket }
  1881.  
  1882. constructor TServerSocket.Create(AOwner: TComponent);
  1883. begin
  1884.   inherited Create(AOwner);
  1885.   FServerSocket := TServerWinSocket.Create(INVALID_SOCKET);
  1886.   FServerSocket.OnSocketEvent := DoEvent;
  1887.   FServerSocket.OnErrorEvent := DoError;
  1888.   FServerSocket.ThreadCacheSize := 10;
  1889. end;
  1890.  
  1891. end.
  1892.  
  1893.